home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The 640 MEG Shareware Studio 4
/
The 640 Meg Shareware Studio CD-ROM Volume IV (Data Express)(1994).ISO
/
clang
/
forth030.zip
/
EXTRAS.4TH
< prev
next >
Wrap
Text File
|
1993-05-21
|
2KB
|
59 lines
\ Extra Forth Definitions for Forth/2 3/08/93 bbm
\ Copyright (c) 1993 BLUE STAR SYSTEMS
1 constant IMMEDIATE_BIT
2 constant COMPILE_ONLY_BIT
4 constant HIDDEN_BIT
: HIDDEN ( -- ) \ Marks latest word as hidden from WORDS listing
Current @ +VLink @ FFA DUP @ HIDDEN_BIT OR SWAP ! ;
: IMMEDIATE? ( lfa -- f ) FFA @ IMMEDIATE_BIT AND ;
: HIDDEN? ( lfa -- f ) FFA @ HIDDEN_BIT AND ;
\ For TO variables or VALUE's
: VALUE ( n -- ) INTEGER HERE CELL - ! ; \ For compatibility
: !> TO ;
: +> +TO ;
: INCR> 1 +TO ;
: DECR> -1 +TO ;
: ON> TRUE TO ;
: OFF> FALSE TO ;
-1 constant ?DOFlag \ Flag signals a ?DO versus a DO
: DoCheck 2DUP > ; \ Check if DO can be called
: ?DOLoop SP@ CSP @ U< IF DUP ?DOFlag <> IF 0 THEN
ELSE 0 THEN ;
: ?DO POSTPONE DoCheck POSTPONE IF ?DOFlag
POSTPONE DO ; IMMEDIATE
: LOOP POSTPONE LOOP
?DOLoop IF \ Only if ?DO was issued
POSTPONE ELSE POSTPONE 2DROP POSTPONE THEN
THEN ; IMMEDIATE
: +LOOP POSTPONE +LOOP \ ?DO will not work with a negative index
?DOLoop IF \ Only if ?DO was issued
POSTPONE ELSE POSTPONE 2DROP POSTPONE THEN
THEN ; IMMEDIATE
\ REMOVEVOC removes the top vocabulary from CONTEXT: LOCALS RemoveVoc
: REMOVEVOC ( -- ) CONTEXT CELL+ CONTEXT ContextSize 1- CELLS CMOVE ;
\ Planned support:
: .VOCS ( -- ) ( Show names of all vocabularies currently defined ) ;
: COMMENT: ( like 0 #if ) ;
: COMMENT; ( like \ #endif ) ;